home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS065.dsk / FILE CABINET IV.bas < prev    next >
BASIC Source File  |  2012-02-16  |  15KB  |  446 lines
  1. 0  POKE 216,0
  2. 1  REM MODIFIED BY GARY FOOTE 5/16/79
  3. 1000  PRINT "<CTRL-D>MAXFILES1"
  4. 1010 D$ = "<CTRL-D>": REM CTRL D
  5. 1020  PRINT D$"NOMON,I,O,C"
  6. 1030  TEXT : HOME 
  7. 1040  GOSUB 5180
  8. 1050  CLEAR 
  9. 1060  DIM R$(65),AC(21),K(65),H$(21),RN$(21)
  10. 1070  DIM Z$(21)
  11. 1080 COMMA$ = "NO"
  12. 1090 D$ = "<CTRL-D>": REM CTRL D
  13. 1100 H$(0) = "REC#"
  14. 1110 DB$ = "":F$ = "BASENAME": ONERR  GOTO 2610
  15. 1120  GOSUB 4110
  16. 1130  GOTO 2470
  17. 1140 F$ = "HEADER": ONERR  GOTO 1520
  18. 1150  GOSUB 4110
  19. 1160  FOR I = 1 TO NR:H$(I) = R$(I): NEXT I
  20. 1170 NH = NR -1:NR = 0:MEM =  FRE(0)
  21. 1180 B =  INT(MEM/(3 *NH + VAL(H$(NH +1))))
  22. 1190  DIM N$(B,NH),R(B)
  23. 1200 F$ = "INDEX": ONERR  GOTO 4830
  24. 1210  GOSUB 4110
  25. 1220  GOTO 4810
  26. 1230  REM *** SORT ***
  27. 1240 N = NR:M = N
  28. 1250 M =  INT(M/2):K = N -M:J = 1: PRINT "SORTING ";: IF M = 0  THEN  PRINT "<CTRL-G>DONE<CTRL-G>": RETURN 
  29. 1260 I = J
  30. 1270 LL = I +M:I2 = R(I):L2 = R(LL): ON L GOTO 1290: IF  VAL(N$(I2,S)) < =  VAL(N$(L2,S))  THEN 1300
  31. 1280  GOTO 1295
  32. 1290  IF N$(I2,S) < = N$(L2,S)  THEN 1300
  33. 1295 Y = R(I):R(I) = R(LL):R(LL) = Y:I = I -M: IF I > = 1  THEN 1270
  34. 1300 J = J +1: IF J >K  THEN 1250
  35. 1305  GOTO 1260
  36. 1415  GOSUB 1440: GOSUB 1240
  37. 1420  PRINT "<CTRL-G>": PRINT "WANT TO SAVE THE "DB$" FILE": PRINT "SORTED BY "H$(S)" TO DISK ";: INPUT "Y/N) ?";L$: IF L$ = "Y"  THEN F$ = "INDEX": GOSUB 4280
  38. 1430  GOTO 4810
  39. 1440 MF = 1: GOSUB 3880
  40. 1450  INPUT "ENTER # OF FIELD FOR SORT ";S$:S =  VAL(S$): IF S <1  OR S >NH  THEN 1450
  41. 1460  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  42. 1470  PRINT "1 ALPHABETICALLY"
  43. 1480  PRINT "2 NUMERICALLY"
  44. 1490  PRINT 
  45. 1500  INPUT "WHICH ";L$:L =  VAL(L$)
  46. 1510  PRINT : PRINT "SORTING ";: RETURN 
  47. 1520  CALL 1013: REM *** CREATE HEADERFILE ***
  48. 1530 NR = 1
  49. 1540  HOME : PRINT "PRESS 'RETURN' TO EXIT TO MENU"
  50. 1550  PRINT 
  51. 1560  PRINT "HEADER FOR COLUMN NUMBER "NR": ";: INPUT "";R$(NR)
  52. 1570  IF R$(NR) = ""  OR NR >20  THEN 1600
  53. 1580 NR = NR +1
  54. 1590  GOTO 1560
  55. 1600  INPUT "AVERAGE RECORD SIZE ";R$(NR): IF  LEN(R$(NR)) = 0  THEN R$(NR) = (NR -1) *10
  56. 1610  GOSUB 4280: GOTO 1160
  57. 1620  REM ***ENTER RECORDS***
  58. 1630  HOME 
  59. 1640  PRINT "THERE ARE "NR" RECORDS"
  60. 1650  PRINT "IN THE "DB$" FILE"
  61. 1660 NR = NR +1:R(NR) = NR
  62. 1670  PRINT "YOU ARE ENTERING RECORD # "NR
  63. 1680  PRINT 
  64. 1690  FOR I = 1 TO NH
  65. 1700  PRINT H$(I)":";: GOSUB 4720:N$(NR,I) = I$
  66. 1705  IF I$ = "/"  THEN N$(NR,I) = N$(NR -1,I)
  67. 1710  NEXT I
  68. 1720  PRINT 
  69. 1730  INPUT "MORE (Y/N) ";L$
  70. 1740  IF L$ = "N"  THEN 1750
  71. 1745  GOTO 1640
  72. 1750 F$ = "INDEX"
  73. 1760  GOSUB 4280
  74. 1770  GOTO 4810
  75. 1780  REM ***SEARCH/CHANGE***
  76. 1790 L = 0
  77. 1800  HOME 
  78. 1810  PRINT "YOU MAY SEARCH BY ANY OF THE FOLLOWING:"
  79. 1820  PRINT 
  80. 1830  GOSUB 3880
  81. 1840  PRINT : PRINT "OR YOU MAY": PRINT 
  82. 1850  PRINT I" MAKE CHANGES"
  83. 1860  PRINT 
  84. 1870  INPUT "WHICH ";S$:S =  VAL(S$)
  85. 1880  IF S <0  OR S >NH +1  THEN 1870
  86. 1890  IF S = NH +1  THEN 2080
  87. 1900  HOME 
  88. 1910  PRINT "PLEASE ENTER THE "H$(S): PRINT "YOU WANT TO FIND.......<CTRL-J>": INPUT "";Q$
  89. 1920  HOME 
  90. 1930  FOR J = 1 TO NR:Y = R(J)
  91. 1940 N$(Y,0) =  STR$(J)
  92. 1950  IF  LEFT$(N$(Y,S), LEN(Q$)) = Q$  THEN  GOSUB 2240
  93. 1960  IF L +NH >20  THEN  GOSUB 2060
  94. 1970  NEXT J
  95. 1980  PRINT "THAT'S ALL OF THEM. ";
  96. 1990  PRINT "NOW YOU MAY:"
  97. 2000  PRINT "1 DO MORE SEARCHES"
  98. 2010  PRINT "2 MAKE CHANGES"
  99. 2020  PRINT "3 RETURN TO THE MAIN MENU"
  100. 2030  INPUT "<CTRL-J>WHICH ";S$:S =  VAL(S$)
  101. 2040  IF S <1  OR S >3  THEN 2030
  102. 2050  ON S GOTO 1800,2080,4810
  103. 2060  IF PF < >0  THEN 2070
  104. 2062  PRINT : PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  105. 2064  GET L$
  106. 2065  IF  ASC(L$) = 27  THEN 4810
  107. 2066  IF  ASC(L$) < >13  THEN 2064
  108. 2070 L = 0: HOME : RETURN 
  109. 2080  REM ***CHANGE DATA***
  110. 2090  PRINT "<CTRL-J>ENTER THE NUMBER OF THE RECORD"
  111. 2100  INPUT "YOU WANT TO CHANGE ";J$:J =  VAL(J$):Y = R(J)
  112. 2110  HOME : GOSUB 2240
  113. 2120  PRINT "<CTRL-J>ENTER THE NUMBER OF THE FIELD YOU WANT": PRINT "TO CHANGE ";
  114. 2130  INPUT "";S$:S =  VAL(S$)
  115. 2140  IF S <1  OR S >NH  THEN 2130
  116. 2150  PRINT 
  117. 2160  PRINT "FROM "H$(S)": "N$(Y,S)
  118. 2170  PRINT 
  119. 2180  PRINT "TO "H$(S)": ";: INPUT "";N$(Y,S)
  120. 2190  HOME : GOSUB 2240
  121. 2200  PRINT 
  122. 2210  INPUT "<CTRL-J>MORE CHANGES (Y/N) ";L$
  123. 2220  IF L$ = "Y"  THEN 2080
  124. 2230 F$ = "INDEX": GOSUB 4280: GOTO 4810
  125. 2240  REM ***PRINT A RECORD***
  126. 2250  ON PF GOSUB 5230,5250
  127. 2260  PRINT "  "H$(0)": ";J
  128. 2270  FOR I = 1 TO NH
  129. 2280  PRINT I" "H$(I)": "N$(Y,I)
  130. 2290  NEXT I
  131. 2300  PRINT 
  132. 2310 L = L +NH +2
  133. 2320  GOSUB 5310
  134. 2330  RETURN 
  135. 2340  REM ***DELETE RECORDS***
  136. 2350  HOME 
  137. 2360  INPUT "ENTER RECORD NUMBER YOU WANT DELETED ";DR$:DR =  VAL(DR$)
  138. 2370  IF DR <1  OR DR >NR  THEN 2360
  139. 2380  FOR J = DR TO NR -1
  140. 2390 R(J) = R(J +1)
  141. 2420  NEXT J:NR = NR -1
  142. 2430  PRINT : PRINT "RECORD NUMBER "DR" DELETED!": PRINT 
  143. 2440  INPUT "MORE (Y/N) ";L$
  144. 2450  IF L$ = "Y"  THEN 2360
  145. 2460 F$ = "INDEX": GOSUB 4280: GOTO 4810
  146. 2470  REM *** BASENAMEFILE ROUTINES ***
  147. 2480  HOME 
  148. 2490  PRINT "SELECT FROM:": PRINT 
  149. 2500  FOR J = 1 TO NR: PRINT J" "R$(J): NEXT J: PRINT 
  150. 2510  PRINT J" CREATE A NEW DATA BASE"
  151. 2520  IF J >1  THEN  PRINT J +1" DELETE A DATA BASE"
  152. 2530  PRINT 
  153. 2540  INPUT "WHICH ";S$:S =  VAL(S$)
  154. 2550  IF S = J +1  THEN 2660
  155. 2560  IF S <1  OR S >J  THEN  PRINT  CHR$(7);: VTAB  PEEK(37): CALL  -868: GOTO 2540
  156. 2570 DB$ = R$(S)
  157. 2580  IF S < >J  THEN 1140
  158. 2590  PRINT 
  159. 2600  GOTO 2620
  160. 2610  CALL 1013
  161. 2620  IF J = 0  THEN J = 1
  162. 2630  INPUT "NAME FOR NEW DATA BASE FILE :";R$(J)
  163. 2640 NR = J: GOSUB 4280
  164. 2650 DB$ = R$(J -1): GOTO 1140
  165. 2660  REM     *** DELETE A DATA BASE ***
  166. 2670  PRINT : INPUT "DELETE WHICH : ";S$:S =  VAL(S$)
  167. 2680  IF S <1  OR S >J -1  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -868: GOTO 2670
  168. 2690  HOME : VTAB (9): PRINT "READY TO DELETE " CHR$(34);R$(S); CHR$(34);".": PRINT 
  169. 2700  PRINT "ONCE DELETED, THIS DATA CANNOT BE"
  170. 2710  PRINT "RECOVERED.  ARE YOU SURE THAT YOU"
  171. 2720  PRINT "WANT TO DELETE IT? (Y/N) ";: INPUT "";S$
  172. 2730  IF S$ < >"Y"  THEN 2470
  173. 2740  HOME : VTAB 12: HTAB 11: INVERSE : PRINT  CHR$(91);" DELETING DATABASE ]": NORMAL 
  174. 2750  ONERR  GOTO 2830
  175. 2760 DB$ = R$(S)
  176. 2770 F$ = "RPTFMTNAME"
  177. 2780  GOSUB 4110
  178. 2790  PRINT D$;"DELETE"DB$" "F$"FILE"
  179. 2800  FOR I = 1 TO NR
  180. 2810  PRINT D$;"DELETE"DB$" "R$(I)" RPTFMTFILE"
  181. 2820  NEXT I
  182. 2830  CALL 1013: PRINT D$"DELETE"DB$" RPTFMTNAMEFILE"
  183. 2840  PRINT D$"DELETE"DB$" INDEXFILE"
  184. 2850  PRINT D$"DELETE"DB$" HEADERFILE"
  185. 2860 DB$ = ""
  186. 2870 F$ = "BASENAME": GOSUB 4110
  187. 2880  IF NR = 1  THEN  PRINT D$"DELETE BASENAMEFILE": GOTO 4810
  188. 2890  FOR I = S TO NR -1
  189. 2900 R$(I) = R$(I +1)
  190. 2910  NEXT I
  191. 2920 NR = NR -1: GOSUB 4280
  192. 2930  GOTO 2470
  193. 2940  REM ***REPORT***
  194. 2950 T9 = 0
  195. 2960  HOME :E = 0
  196. 2970  FOR I = 0 TO 3 *NH +3:K(I) = 0: NEXT I
  197. 2980  FOR I = 0 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0
  198. 2990  ON E GOTO 3150
  199. 3000  GOTO 3940
  200. 3010  PRINT : INPUT "HOW MANY HEADERS ";RH$:RH =  VAL(RH$): IF RH <1  OR RH >NH +1  THEN 3010
  201. 3020  IF E = 0  THEN RN$(NN) = "PRESENT"
  202. 3030  FOR I = 1 TO RH *3  STEP 3
  203. 3040  PRINT "ENTER # OF HEADER YOU WANT IN": PRINT "POSITION #"(I +2)/3" ";: INPUT "";K$:K(I) =  VAL(K$)
  204. 3050  IF K(I) <0  OR K(I) >NH  THEN 3040
  205. 3060  PRINT "ENTER TAB FOR "H$(K(I))" ";: INPUT "";K$:K(I +1) =  VAL(K$)
  206. 3070  IF K(I +1) <0  OR K(I +1) >255  THEN 3060
  207. 3080  PRINT "TOTAL ON "H$(K(I))" (Y/N) ";: INPUT L$
  208. 3090  IF L$ = "Y"  THEN K(I +2) = 1:K(0) = 1
  209. 3100  NEXT I
  210. 3110  IF K(0) < >1  THEN 3147
  211. 3120  INPUT "ENTER TAB FOR TOTAL: ";A$
  212. 3130  IF  LEN(A$) = 0  THEN K(0) = 0:T9 = 1: GOTO 3143
  213. 3140 K(I +1) =  VAL(A$): IF K(I +1) <0  OR K(I +1) >131  THEN  PRINT "<CTRL-G>": VTAB  PEEK(37) -1: GOTO 3120
  214. 3143  INPUT "DO YOU WANT A SUMMARY REPORT?";S$: IF S$ = "Y"  THEN K(0) = 2
  215. 3147 LL = 0: INPUT "DO YOU WANT THIS REPORT SORTED? ";S$: IF S$ = "Y"  THEN LL = 1:K(I +2) = 1
  216. 3150  PRINT 
  217. 3160  INPUT "SELECT RECORDS BY WHICH HEADER # ";S$:S =  VAL(S$)
  218. 3170  IF  LEN(S$) = 0  THEN Q$ = "@": GOTO 3230
  219. 3180  PRINT : INPUT "'AND' 2ND HEADER (Y/N) ";L$: IF L$ < >"Y"  THEN X$ = "@": GOTO 3200
  220. 3190  PRINT : INPUT "ENTER # OF 'AND' HEADER ";X$:X =  VAL(X$)
  221. 3200  PRINT : PRINT "@ WILL SELECT ALL RECORDS."
  222. 3210  PRINT : PRINT "SELECT RECORDS FOR "H$(S)"= ";: INPUT "";Q$: PRINT 
  223. 3220  IF L$ = "Y"  THEN  PRINT "AND "H$(X)"= ";: INPUT "";X$
  224. 3225  IF LL < >0  THEN L = LL: GOSUB 1240
  225. 3230  REM 
  226. 3250  ON PF GOSUB 5230,5250,5280: GOSUB 3610:Z$ = N$(R(1),S):RR = 0
  227. 3260  FOR J = 1 TO NR:Y = R(J)
  228. 3270 N$(Y,0) =  STR$(J)
  229. 3280  IF Q$ = "@"  THEN 3320
  230. 3290  IF  LEFT$(N$(Y,S), LEN(Q$)) < >Q$  THEN 3330
  231. 3300  IF X$ = "@"  THEN 3320
  232. 3310  IF  LEFT$(N$(Y,X), LEN(X$)) < >X$  THEN 3330
  233. 3320  GOSUB 3435:Z$ = N$(Y,S)
  234. 3330  IF PF <1  THEN  IF L >18  THEN  GOSUB 2060: GOSUB 3610
  235. 3340  IF L = 0  THEN  GOSUB 3610
  236. 3350  NEXT J
  237. 3355  IF K(0) < >0  THEN  POKE 36,K(3 *I -1): PRINT HC:GT = GT +HC:HC = 0: GOSUB 3540
  238. 3357  PRINT 
  239. 3360  ON T9 GOSUB 3540
  240. 3370  GOSUB 5310
  241. 3380  ON E GOTO 3410
  242. 3390  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT": INPUT "FOR THIS REPORT TO DISK (Y/N) ";L$
  243. 3400  IF L$ = "Y"  THEN E = 1: GOSUB 3720
  244. 3410  PRINT : PRINT "MORE REPORTS USING THE "RN$(NN)" FORMAT": INPUT "(Y/N) ";L$
  245. 3420  IF L$ = "Y"  THEN  GOSUB 3880:E = 1: GOTO 2980
  246. 3430  GOTO 4810
  247. 3435  IF K(0) < >0  THEN  IF N$(Y,S) < >Z$  THEN  POKE 36,K(3 *I -1): PRINT HC:GT = GT +HC:HC = 0:RR = 0:L = L +1: IF L >18  THEN  GOSUB 2060: GOSUB 3610
  248. 3437  IF RR = 0  THEN  IF K(0) = 1  THEN  PRINT 
  249. 3440  FOR I = 1 TO RH
  250. 3445  IF K(3 *I)  THEN  GOSUB 3510: IF K(0) = 2  THEN 3470
  251. 3447  IF K(0) = 2  THEN  IF RR < >0  THEN 3470
  252. 3450  POKE 36,K(3 *I -1): PRINT N$(Y,K(3 *I -2));
  253. 3470  NEXT I
  254. 3480 RR = 1
  255. 3490  IF K(0) < >2  THEN L = L +1: PRINT 
  256. 3500  RETURN 
  257. 3510 N = 3 *I -2
  258. 3520 V =  VAL(N$(Y,K(N))):AC(I) = AC(I) +V:HC = HC +V
  259. 3530  RETURN 
  260. 3540  PRINT : FOR I = 1 TO 39 +((PF >1) *39): PRINT "-";: NEXT I: PRINT 
  261. 3550  FOR I = 1 TO RH
  262. 3560  IF AC(I) = 0  THEN 3580
  263. 3570  POKE 36,K(3 *I -1): PRINT AC(I);
  264. 3580  NEXT I
  265. 3590  IF GT < >0  THEN  POKE 36,K(3 *I -1): PRINT GT;
  266. 3600  PRINT : RETURN 
  267. 3610  HOME 
  268. 3620  PRINT RN$(NN)" REPORT FOR "H$(S)":"Q$;
  269. 3630  IF X$ = "@"  THEN 3650
  270. 3640  PRINT " AND "H$(X)":"X$: GOTO 3660
  271. 3650  PRINT "<CTRL-J>"
  272. 3660  FOR I = 1 TO RH
  273. 3670  POKE 36,K(3 *I -1): PRINT H$(K(3 *I -2));
  274. 3675  IF K(3 *I)  THEN X = K(3 *I -1)
  275. 3680  NEXT I
  276. 3690  IF K(0) < >0  THEN  IF X < >K(3 *I -1)  THEN  POKE 36,K(3 *I -1): PRINT "TOTAL";
  277. 3700  PRINT : PRINT 
  278. 3710 L = 4: RETURN 
  279. 3720  REM *** SET-UP TO SAVE RPTFMTFILE ***
  280. 3730 NS = NR
  281. 3740  PRINT : INPUT "ENTER THE REPORT FORMAT NAME ";RN$(NN)
  282. 3750 F$ = RN$(NN) +" RPTFMT"
  283. 3760 NR = 3 *RH +3
  284. 3770  FOR I = 1 TO NR:R$(I) =  STR$(K(I)): NEXT I
  285. 3780 R$(I -3) =  STR$(K(0))
  286. 3790  GOSUB 4280: GOSUB 4440
  287. 3800  RETURN 
  288. 3810  REM *** SET-UP TO READ RPTFMTFILE ***
  289. 3820 F$ = RN$(NN) +" RPTFMT"
  290. 3830  GOSUB 4110
  291. 3840 RH = (NR -3)/3: FOR I = 1 TO NR:K(I) =  VAL(R$(I)): NEXT I
  292. 3850 K(0) =  VAL(R$(I -3)):LL =  VAL(R$(I -1))
  293. 3860 NR = NS
  294. 3870  GOSUB 3880: PRINT : GOTO 3160
  295. 3880  REM *** SUB MENU ***
  296. 3890  HOME : PRINT "SELECT FROM:": PRINT 
  297. 3900  IF MF = 0  THEN  PRINT "0 "H$(0)
  298. 3910  FOR I = 1 TO NH: PRINT I" "H$(I): NEXT I: PRINT 
  299. 3920 MF = 0
  300. 3930  RETURN 
  301. 3940  REM *** READ REPORTNAMEFILE & SELECT REPORT ***
  302. 3950 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  303. 3960 F$ = "RPTFMTNAME"
  304. 3970  ONERR  GOTO 4070
  305. 3980  GOSUB 4110
  306. 3990  FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  307. 4000  HOME : PRINT "SELECT FROM:": PRINT 
  308. 4010  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  309. 4020  PRINT I" CREATE A NEW REPORT FORMAT": PRINT 
  310. 4030  INPUT "WHICH ";S$:S =  VAL(S$): IF S <1  OR S >I  THEN 4030
  311. 4040 NN = S
  312. 4050  IF S < >I  THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 3810
  313. 4060  GOTO 4100
  314. 4070  CALL 1013: HOME : PRINT "NO REPORT FORMATS ON DISK...": PRINT 
  315. 4080 NN = 1
  316. 4090  INPUT "DO YOU WANT TO CREATE ONE (Y/N) ?";L$: IF L$ < >"Y"  THEN 4810
  317. 4100  GOSUB 3880:NR = NS: GOTO 3010
  318. 4110  REM *** READ FILES ***
  319. 4120  IF F$ < >"INDEX"  THEN FF = 1
  320. 4130  PRINT D$"OPEN"DB$" "F$"FILE"
  321. 4140  PRINT D$"READ"DB$" "F$"FILE"
  322. 4150  INPUT NR
  323. 4160  FOR J = 1 TO NR
  324. 4170  ON FF GOTO 4230
  325. 4180  FOR I = 1 TO NH
  326. 4190  GOSUB 4720
  327. 4200 N$(J,I) = I$
  328. 4210  NEXT I
  329. 4215 R(J) = J
  330. 4220  GOTO 4240
  331. 4230  INPUT R$(J)
  332. 4240  NEXT J
  333. 4250  PRINT D$"CLOSE"
  334. 4260 FF = 0
  335. 4270  RETURN 
  336. 4280  REM *** SAVE FILES ***
  337. 4290  IF F$ < >"INDEX"  THEN FF = 1
  338. 4300  PRINT D$"OPEN"DB$" "F$"FILE"
  339. 4310  PRINT D$"WRITE"DB$" "F$"FILE"
  340. 4320  PRINT NR
  341. 4330  FOR J = 1 TO NR
  342. 4340  ON FF GOTO 4390
  343. 4345 Y = R(J)
  344. 4350  FOR I = 1 TO NH
  345. 4360  PRINT N$(Y,I)
  346. 4370  NEXT I
  347. 4380  GOTO 4400
  348. 4390  PRINT R$(J)
  349. 4400  NEXT J
  350. 4410  PRINT D$"CLOSE"
  351. 4420 FF = 0
  352. 4430  RETURN 
  353. 4440  REM *** SAVE REPORTNAMEFILE ***
  354. 4450 NR = NN
  355. 4460 F$ = "RPTFMTNAME"
  356. 4470  FOR I = 1 TO NR:R$(I) = RN$(I): NEXT I
  357. 4480  GOSUB 4280
  358. 4490 NR = NS: RETURN 
  359. 4500  REM  *** LIST ***
  360. 4510 L = 0
  361. 4520  HOME 
  362. 4530  FOR J = 1 TO NR:Y = R(J)
  363. 4540  ON PF GOSUB 5230,5250,5280
  364. 4550  PRINT "  "H$(0)": ";J:L = L +1
  365. 4560  FOR I = 1 TO NH
  366. 4570  PRINT I" "H$(I)": "N$(Y,I)
  367. 4580 L = L +1
  368. 4590  NEXT I
  369. 4600  PRINT :L = L +1
  370. 4610  IF L +NH >20  THEN 4660
  371. 4620  NEXT J
  372. 4630  GOSUB 5310
  373. 4640  INPUT "HIT RETURN FOR MENU...";L$
  374. 4650  GOTO 4810
  375. 4660  GOSUB 5310
  376. 4670  PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  377. 4672  GET L$
  378. 4674  IF  ASC(L$) = 27  THEN 4810
  379. 4676  IF  ASC(L$) = 13  THEN 4680
  380. 4678  GOTO 4672
  381. 4680  HOME :L = 0
  382. 4690  ON PF GOSUB 5230,5250,5280
  383. 4700  GOTO 4620
  384. 4710  STOP 
  385. 4720  REM   ***  INPUT ROUTINES  ***
  386. 4730 I$ = ""
  387. 4740  IF COMMA$ = "NO"  THEN  INPUT "";I$: RETURN 
  388. 4750  GET A$
  389. 4760  IF A$ =  CHR$(3)  THEN  STOP 
  390. 4770  PRINT A$;
  391. 4780  IF A$ =  CHR$(13)  THEN  RETURN 
  392. 4790 I$ = I$ +A$
  393. 4800  GOTO 4750
  394. 4810  REM *** MAIN MENU ***
  395. 4820  GOTO 4840
  396. 4830  CALL 1013
  397. 4840  HOME 
  398. 4850  PRINT "******* DATA BASE MANAGEMENT II ******"
  399. 4860  PRINT : PRINT "          APPLE COMPUTER INC"
  400. 4870  PRINT "       MODIFIED BY GARY A. FOOTE"
  401. 4880  PRINT "CURRENT DATA BASE: "DB$: PRINT 
  402. 4890  PRINT "CURRENTLY CONTAINS: "NR" RECORDS": PRINT : PRINT "ROOM FOR "B -NR" MORE RECORDS"
  403. 4900  PRINT 
  404. 4910  IF PF > = 1  THEN  PRINT "THE PRINTER IS ";: FLASH : PRINT "ON": NORMAL : GOTO 4930
  405. 4920  PRINT "THE PRINTER IS OFF"
  406. 4930  PRINT 
  407. 4940  PRINT "1  SELECT DATA BASE"
  408. 4950  PRINT "2  SEARCH AND/OR CHANGE DATA"
  409. 4960  PRINT "3  ENTER RECORDS"
  410. 4970  PRINT "4  DELETE RECORDS"
  411. 4980  PRINT "5  REPORT"
  412. 4990  PRINT "6  SORT"
  413. 5000  PRINT "7  TURN ON PRINTER"
  414. 5010  PRINT "8  TURN OFF PRINTER"
  415. 5020  PRINT "9  LIST ALL RECORDS"
  416. 5030  PRINT "10 QUIT"
  417. 5040  PRINT 
  418. 5050  INPUT "WHICH ";S$:S =  VAL(S$)
  419. 5060  IF S <1  OR S >10  THEN 4810
  420. 5070  ON S GOTO 1050,1780,1620,2340,2940,1415,5080,5160,4500,5170
  421. 5080  HOME 
  422. 5090  PRINT "PRINTER OPTIONS:"
  423. 5100  PRINT "1 40 COLUMNS"
  424. 5110  PRINT "2 80 COLUMNS"
  425. 5120  PRINT "3 132 COLUMNS"
  426. 5130  PRINT : INPUT "WHICH ";PF$:PF =  VAL(PF$)
  427. 5140  IF PF <1  OR PF >3  THEN 5130
  428. 5150  GOTO 4810
  429. 5160 PF = 0: GOTO 4810
  430. 5170  PRINT "MAXFILES3": END 
  431. 5180  REM *** APPLESOFT ONERR CORRECTION
  432. 5190  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT I
  433. 5200 I = 0
  434. 5210  RETURN 
  435. 5220  DATA 104,168,104,166,223,154,72,152,72,96
  436. 5230  PRINT D$"PR#1"
  437. 5240  PRINT "<CTRL-I>K": RETURN 
  438. 5250  PRINT D$"PR#1"
  439. 5260  PRINT "<CTRL-I>K<CTRL-I>80N"
  440. 5270  RETURN 
  441. 5280  PRINT D$"PR#1"
  442. 5290  PRINT "<CTRL-I>K<CTRL-I>132N"
  443. 5300  RETURN 
  444. 5310  IF PF = 0  THEN  RETURN 
  445. 5320  PRINT D$"PR#0"
  446. 5330  RETURN